home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Languguage OS 2
/
Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO
/
language
/
parallax
/
more_exa.tar
/
more
/
Skeleton
/
skeleton.p
< prev
Wrap
Text File
|
1992-08-24
|
12KB
|
530 lines
(**************************************************************************)
(*** ***)
(*** SKELETON.P ***)
(*** ***)
(*** Author : Michael Reinhardt ***)
(*** Language : Parallaxis V2 ***)
(*** Last Change : May, 11, 1992 ***)
(*** ***)
(*** Description : This program thins a picture given in ***)
(*** pbm-format ***)
(*** ***)
(**************************************************************************)
SYSTEM Thinning ;
CONST
MaxWidth = 464 ; (* maximal Width of input image *)
MaxHeight = 98 ; (* maximal Height of input image*)
MaxStringLength = 200 ; (* maximal Stringlength *)
ByteLength = 8 ; (* number of bits per byte *)
MaxByteValue = 2**ByteLength;(* maximum value of a byte *)
(****************************************************************)
(* Magic Numbers for the Pictures in PBM-Plus Format *)
(****************************************************************)
P1 = "P1"; (* Blackpicture ASCII-Option *)
P4 = "P4"; (* Blackpicture RAWBIT-Option *)
PBM = ".pbm"; (* Extension for pbm-Files *)
(****************************************************************)
TYPE
STRING = ARRAY [ 0 .. MaxStringLength ] OF CHAR;
BlackPicture = ARRAY [ 1 .. MaxHeight ] , [ 1 .. MaxWidth ] OF BOOLEAN;
BitField8 = ARRAY [ 1 .. ByteLength ] OF BOOLEAN;
CONFIGURATION
(********************************************************)
(* Twodimensional Grid *)
(********************************************************)
grid [ 1 .. MaxHeight ] , [ 1 .. MaxWidth ];
CONNECTION
(********************************)
(* p1 p2 p3 *)
(* \ | / *)
(* p8 - p - p4 *)
(* / | \ *)
(* p7 p6 p5 *)
(********************************)
lo : grid[ i , j ] -> grid[ i+1 , j-1 ].ru;
o : grid[ i , j ] -> grid[ i+1 , j ].u;
ro : grid[ i , j ] -> grid[ i+1 , j+1 ].lu;
r : grid[ i , j ] -> grid[ i , j+1 ].l;
ru : grid[ i , j ] -> grid[ i-1 , j+1 ].lo;
u : grid[ i , j ] -> grid[ i-1 , j ].o;
lu : grid[ i , j ] -> grid[ i-1 , j-1 ].ro;
l : grid[ i , j ] -> grid[ i , j-1 ].r;
(************************* strcat *******************************************)
(* catenation of two strings *)
(****************************************************************************)
PROCEDURE strcat( SCALAR first , second : STRING ) : SCALAR STRING ;
SCALAR
i , j : INTEGER ;
BEGIN
i := 0 ; j := 0 ;
WHILE ( ( first[i] <> CHR(0) ) AND ( i < MaxStringLength ) ) DO
INC(i);
END ;
WHILE ( ( second[j] <> CHR(0) ) AND ( i < MaxStringLength ) ) DO
first[i] := second[j] ;
INC(j) ;INC(i) ;
END ;
first[i] := CHR(0) ;
RETURN first ;
END strcat ;
(****************** BitField2Char *******************************************)
(* Conversion 8bit field into a char value *)
(***************************************************************************)
PROCEDURE BitField2Char ( SCALAR BitField :BitField8 ) : SCALAR CHAR;
SCALAR
code : INTEGER;
index : INTEGER;
BEGIN
code := 0;
FOR index := 0 TO ( ByteLength - 1 ) DO
IF BitField[ByteLength - index]
THEN
code := code + 2**index;
END; (* IF *)
END; (* FOR *)
RETURN CHR ( code);
END BitField2Char;
(****************** Char2BitField *******************************************)
(* Conversion char value into 8bit field *)
(***************************************************************************)
PROCEDURE Char2BitField ( SCALAR ch :CHAR ) : SCALAR BitField8;
SCALAR
code : INTEGER;
index : INTEGER;
BitField : BitField8;
rest : INTEGER;
BEGIN
code := ORD ( ch );
rest := MaxByteValue;
FOR index := (ByteLength - 1) TO 0 BY -1 DO
rest := rest DIV 2;
IF code >= rest
THEN
BitField[ByteLength - index] := TRUE;
code := code - rest;
ELSE
BitField[ByteLength - index] := FALSE;
END; (* IF *)
END; (* FOR *)
RETURN BitField;
END Char2BitField;
(************** WriteInteger ********************************************)
(* Print Integer value with automatic length determination *)
(************************************************************************)
PROCEDURE WriteInteger ( SCALAR Val : INTEGER );
SCALAR
Length : INTEGER;
BEGIN
Length := TRUNC ( Ln ( FLOAT ( ABS ( Val ) + 1 ) ) /
Ln ( 10.0 ) ) + 1;
IF Val < 0
THEN
Length := Length + 2;
END; (* IF *)
WriteInt ( Val , Length );
END WriteInteger;
(************** ReadHeader *****************************************)
(* Reads Header of PPM or PBM file *)
(* Returns Height, Width, DeltaX and DeltaY of image *)
(*******************************************************************)
PROCEDURE ReadHeader (SCALAR InputFile : STRING;
SCALAR VAR PicWidth, PicHeight, MaxColors : INTEGER)
: SCALAR BOOLEAN;
SCALAR
magic, comment : STRING;
ch : CHAR;
kommentar : BOOLEAN;
Ergebnis : BOOLEAN;
BEGIN
OpenInput( InputFile ) ; (* open File *)
Ergebnis := TRUE;
PicWidth := 0;
PicHeight := 0;
MaxColors := 0;
IF Done THEN
ReadString( magic ) ;
ReadString ( comment );
IF ( comment[0] = "#" )
THEN
kommentar := TRUE;
ELSE
kommentar := FALSE;
END; (* IF *)
IF NOT kommentar
THEN
CloseInput;
OpenInput ( InputFile );
ReadString ( magic );
ELSE
ch := CHR ( 0 );
WHILE ch <> EOL DO
Read ( ch );
END; (* IF *)
END; (* IF *)
ReadInt( PicWidth ) ; (* reading Height and Width of image *)
ReadInt( PicHeight ) ;
WriteString ( " black & white image " );
IF STREQ ( P4 , magic )
THEN
WriteString ( "compressed" );
Read ( ch );
ELSE
WriteString ( "not compressed" );
END; (* IF *)
WriteLn;
WriteString ( " File : " );
WriteString ( InputFile );
WriteString ( " Magic : " );
WriteString ( magic );
WriteLn;
WriteString ( " Width : " );
WriteInteger ( PicWidth );
WriteString ( " Height : " );
WriteInteger ( PicHeight );
WriteString ( " Colors : ");
WriteInteger ( MaxColors );
WriteLn;
WriteLn;
ELSE
WriteLn;
WriteString ( " ERROR !!! " );
WriteLn;
WriteString ( " File : " );
WriteString ( InputFile );
WriteString ( " couldn't get opened !!! " );
WriteLn;
Ergebnis := FALSE;
END; (* IF *)
IF (PicHeight > MaxHeight) OR (PicWidth > MaxWidth)
THEN
WriteLn;
WriteString ( " ERROR !!! " );
WriteLn;
WriteString ( " File : " );
WriteString ( InputFile );
WriteLn;
WriteString ( "The image is too large for being processsed !!!" );
WriteLn;
WriteString ( "Maximum width : " );
WriteInteger ( MaxWidth );
WriteLn;
WriteString ( "Maximum height : " );
WriteInteger ( MaxHeight );
Ergebnis := FALSE;
END; (* IF *)
Ergebnis := Ergebnis AND Done;
RETURN Ergebnis;
END ReadHeader;
(************************** ReadComPBM ***************************)
(* Reads a compressed PBM file *)
(************************************************************************)
PROCEDURE ReadComPBM (
SCALAR InputFile : STRING;
SCALAR VAR Image : BlackPicture;
SCALAR VAR PicWidth, PicHeight : INTEGER )
: SCALAR BOOLEAN ;
SCALAR
XPos, YPos, index, X : INTEGER;
FileName : STRING;
Ch : CHAR;
BitField : BitField8;
MaxColor : INTEGER;
Result : BOOLEAN;
BEGIN
FileName := strcat ( InputFile , PBM );
Result := ReadHeader ( FileName , PicWidth, PicHeight , MaxColor );
WriteString ("Reading input ..."); WriteLn;
IF Result THEN
FOR YPos := 1 TO PicHeight DO
XPos := 0;
FOR X := 0 TO ( PicWidth - 1 ) DIV ByteLength DO
Read ( Ch );
BitField := Char2BitField ( Ch );
FOR index := 1 TO ByteLength DO
INC ( XPos );
IF XPos <= PicWidth
THEN
Image[YPos][XPos]
:= BitField[index];
END; (* IF *)
END; (* FOR index *)
END; (* FOR X *)
END; (* FOR YPos *)
END; (* IF *)
CloseInput;
WriteString ("Input read."); WriteLn;
RETURN Result;
END ReadComPBM ;
(************************* WriteComPBM ***************************)
(* Writes compressed PBM file *)
(************************************************************************)
PROCEDURE WriteComPBM (
SCALAR OutputFile : STRING;
SCALAR Image : BlackPicture;
SCALAR PicWidth, PicHeight : INTEGER )
: SCALAR BOOLEAN;
SCALAR
XPos, YPos, index, X : INTEGER;
FileName : STRING;
Ch : CHAR;
BitField : BitField8;
BEGIN
FileName := strcat ( OutputFile , PBM );
WriteString ("Writing output ..."); WriteLn;
OpenOutput( FileName ) ;
WriteString ( P4 ) ; (* RAWBIT option, not ASCII *)
WriteLn;
WriteString ( "# " );
WriteString ( FileName );
WriteLn;
WriteInteger ( PicWidth ); (* without vertical margins *)
Write (" ");
WriteInteger ( PicHeight ); (* without horizontal margins *)
WriteLn;
FOR YPos := 1 TO PicHeight DO
XPos := 0;
FOR X := 0 TO ( PicWidth - 1 ) DIV ByteLength DO
FOR index := 1 TO ByteLength DO
INC ( XPos );
IF XPos <= PicWidth
THEN
BitField[index] := Image[YPos][XPos];
ELSE
BitField[index] := TRUE;
END; (* IF *)
END; (* FOR index *)
Ch := BitField2Char ( BitField );
Write ( Ch );
END; (* FOR X *)
END; (* FOR YPos *)
CloseOutput ;
WriteString ("Output written."); WriteLn;
RETURN TRUE;
END WriteComPBM ;
(******* ThinningZA2 ***************************************)
(* Thinning Algorithm with 2 subiterations *)
(****************************************************************)
PROCEDURE ThinningZA2 ( SCALAR InImage : BlackPicture;
SCALAR VAR OutImage : BlackPicture;
SCALAR Width, Height : INTEGER );
SCALAR
ende : BOOLEAN;
Direction : INTEGER;
VECTOR
hasChanged,
p1, p2, p3,
p8, p, p4,
p7, p6, p5 : BOOLEAN;
criteria : BOOLEAN;
BEGIN
LOAD grid ( p , InImage );
ende := FALSE;
(********************************)
(* Directions *)
(* 0 = Upper left *)
(* 1 = Lower right *)
(********************************)
Direction := 0;
PARALLEL grid [1..Height],[1..Width]
WHILE NOT ende DO
IF Direction = 0
THEN
hasChanged := FALSE;
END; (* IF *)
PROPAGATE.l ( p , p4 );
PROPAGATE.lo ( p , p5 );
PROPAGATE.o ( p , p6 );
PROPAGATE.ro ( p , p7 );
PROPAGATE.r ( p , p8 );
PROPAGATE.ru ( p , p1 );
PROPAGATE.u ( p , p2 );
PROPAGATE.lu ( p , p3 );
CASE Direction OF
(* From Upper right *)
0 :
criteria := ( NOT p1 AND NOT p2 AND NOT p3 AND
p5 AND p6 )
OR ( NOT p2 AND NOT p3 AND NOT p4 AND
p6 AND p8 );
criteria := criteria OR
( NOT p3 AND NOT p4 AND NOT p5 AND
p7 AND p8 )
OR ( NOT p4 AND NOT p5 AND NOT p6 AND
p8 AND p2 );
(* From lower left *)
| 1 :
criteria := ( NOT p5 AND NOT p6 AND NOT p7 AND
p1 AND p2 )
OR ( NOT p6 AND NOT p7 AND NOT p8 AND
p2 AND p4 );
criteria := criteria OR
( NOT p7 AND NOT p8 AND NOT p1 AND
p3 AND p4 )
OR ( NOT p8 AND NOT p1 AND NOT p2 AND
p4 AND p6 );
END; (* CASE *)
(************************************************)
(* Test, if pixel can be eliminated *)
(************************************************)
IF p AND criteria
THEN
p := FALSE;
hasChanged := TRUE;
END;
IF Direction = 0
THEN
ende := NOT (REDUCE.OR ( hasChanged ));
ELSE
ende := FALSE;
END; (* IF *)
Direction := ( Direction + 1 ) MOD 2;
END; (* WHILE *)
ENDPARALLEL;
STORE grid ( p , OutImage );
END ThinningZA2;
SCALAR InFile, OutFile : STRING;
Image : BlackPicture;
Skeleton : BlackPicture;
Width, Height : INTEGER;
isLoaded, isWritten : BOOLEAN;
BEGIN (* Main *)
WriteString ( "Input PBM file (withput extension .pbm) ? ");
ReadString ( InFile );
WriteLn;
WriteString ( "Thinned output PBM file ? ");
ReadString ( OutFile );
(* Load image *)
isLoaded := ReadComPBM ( InFile , Image ,
Width , Height );
IF isLoaded THEN
WriteString ("Thinning ..."); WriteLn;
ThinningZA2 ( Image , Skeleton, Width, Height );
WriteString ("Thinning done."); WriteLn;
isWritten := WriteComPBM (OutFile, Skeleton, Width, Height);
END; (* IF *)
END Thinning.